home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / pasart.zip / PAS1.ART < prev   
Text File  |  1991-10-19  |  10KB  |  214 lines
  1.         Turbo Pascal is a language which has had many faces.  Since
  2. Borland introduced it in 1982 it has been everything from a purely
  3. teaching language to the high power Turbo Pascal we know today.  But,
  4. the makers of Turbo Pascal have not forgotten its roots.  Today, Turbo
  5. Pascal can be used in writing the simplest application to the most
  6. complex high-speed parrallel processing network applications.
  7.  
  8.         The program below illustrates how easy it is to use Turbo Pascal
  9. to writing a seemingly complex application.  The code is for a program
  10. much like the popular TheDraw~.  This code took me less than 2 hours to
  11. write and is less that 170 lines of code.  With a few additions it could
  12. easily rival any of the popular ANSI Drawing programs... some even like
  13. TheDraw~ which have made their authors a pretty penny!
  14.  
  15. -----------> Beginning of Listing
  16.  
  17. Program ANSIPic;   { The following code may be modified, changed and  }
  18.                    { used in any way you wish.  It may be distributed }
  19. Uses CRT;          { in whole or part and you do NOT have to credit   }
  20.                    { OctagonSoft or Ben Shoval for the code           }
  21. const
  22.   UpArrow   = #72; { These Constants are used to define cursor movements }
  23.   DnArrow   = #80;
  24.   RtArrow   = #77;
  25.   LtArrow   = #75;
  26.   ColorUp   = #73; { These are used to define the keys for changing colors }
  27.   ColorDn   = #81;
  28.   BkColorUp = #71;
  29.   BkColorDn = #79;
  30.   SetDMKey  = #50;
  31.   TRtCorner = #59; { These define the keys for drawing corners }
  32.   TLtCorner = #60;
  33.   BRtCorner = #61;
  34.   BLtCorner = #62;
  35.   ClrKey    = #46; { Key to Clear the Screen }
  36.  
  37. var
  38.   DrawColor : Byte; { Stores the foreground color }
  39.   BKColor   : Byte; { Stores the background color }
  40.   Ch        : Char;
  41.  
  42. Procedure Setup;
  43. Begin
  44.   TextMode(CO80);         { Use 80 by 25 Text Mode }
  45.   HighVideo;              { Use High Intensity Colors }
  46.   TextColor(White);       { Set the starting Foreground color to White }
  47.   DrawColor := White;     { Set the Foreground color variable }
  48.   TextBackground(Black);  { Set the starting Background color to Black }
  49.   BKColor := Black;       { Set the Background color variable }
  50.   ClrScr;                 { Clear the Screen }
  51.   GotoXY(1,1);            { The Following sets up the screen }
  52.   Write('PgUp/PgGn Sets Color - Home/End Sets Background Color - ');
  53.   Write('<ALT>M Toggles Drawing');
  54.   GotoXY(1,25);
  55.   Write('Status: ');
  56.   GotoXY(25,25);
  57.   Write('Cursor Position: ');
  58.   GotoXY(60,25);
  59.   Write('F1 ',#218,' F2 ',#191,' F3 ',#192,' F4 ',#217);
  60.   GotoXY(40,12);          { Put the cursor in the center of the screen }
  61. End;
  62.  
  63. Procedure Draw;
  64. Var
  65.   HiKey      : Boolean; { Set to TRUE is the keypressed is an Extended Key }
  66.   DrawMode   : Boolean; { Set to TRUE if in Drawing Mode }
  67.   PreX, PreY : Byte;    { Used to hold X and Y when they are being written }
  68. Begin
  69.   DrawMode := TRUE;     { Always start out in Drawing Mode }
  70.   Repeat                { Start of loop which exits with ESC or <ALT>X }
  71.  
  72.     PreX := WhereX;     { Get the current X pos }
  73.     PreY := WhereY;     { Get the current Y pos }
  74.     GotoXY(42,25);      { Go to 42,25 to write the current X and Y }
  75.     TextColor(White);   { Writing will be done with White on Black }
  76.     TextBackground(Black);
  77.     Write('(',+PreX,+',',+PreY,+')     '); { The spaces after then ) are needed }
  78.     GotoXY(9,25); { The Following write the Drawing Status }
  79.     if DrawMode = TRUE then Write('Drawing    ') { Spaces are needed }
  80.     else Write('Not Drawing');
  81.     GotoXY(PreX, PreY); { Go back to where you were on the screen }
  82.  
  83.     if DrawColor = BkColor then { Check that the foreground and background }
  84.       inc(DrawColor);           { colors are not the same                  }
  85.     TextColor(DrawColor);       { Set the Foreground color }
  86.     TextBackground(BKColor);    { Set the Background color }
  87.  
  88.     HiKey := False;             { Always assume that it is NOT a Hi Key }
  89.     Ch := Readkey;              { Read a key }
  90.     If Ch=#0 then               { If it is a Hi Key (#0 was returned first) }
  91.       Begin
  92.         Ch := Readkey;          { If we got here then it is a Hi Key }
  93.         HiKey := TRUE;          { Set HiKey to TRUE }
  94.       End;
  95.  
  96.     Case Ch Of
  97.       UpArrow   : Begin { Routine if the Up Arrow was pressed }
  98.                     GotoXY(WhereX,WhereY-1); { Move up a line }
  99.                     if WhereY = 1 then GotoXY(WhereX,2); { make sure we're }
  100.                     if DrawMode = True then              { not on 1st line }
  101.                       Begin  { We're here if we're in drawing mode }
  102.                         Write(#179);
  103.                         GotoXY(WhereX-1,WhereY); { Move the cursor onto the }
  104.                       End;                       { character which was drawn}
  105.                   End;
  106.       DnArrow   : Begin { Routine if the Down Arrow was pressed }
  107.                     GotoXY(WhereX,WhereY+1); { Move down a line }
  108.                     If WhereY = 25 then GotoXY(WhereX,24); { make sure we're }
  109.                     if DrawMode = True then                { not on 25th line}
  110.                       Begin
  111.                         Write(#179);
  112.                         GotoXY(WhereX-1,WhereY); { Move the cursor onto the }
  113.                       End;                       { character which was drawn}
  114.                   End;
  115.       RtArrow   : Begin { Routine if the Right Arrow was pressed }
  116.                     GotoXY(WhereX+1,WhereY); { Move to the right one position }
  117.                     if WhereX = 80 then GotoXY(79,WhereY); { make sure we're }
  118.                     if DrawMode = True then                { not in 79th spot}
  119.                       Begin
  120.                         Write(#196);
  121.                         GotoXY(WhereX-1,WhereY); { Move the cursor onto the }
  122.                       End;                       { character which was drawn}
  123.                   End;
  124.       LtArrow   : Begin { Routine if the Left Arrow was pressed }
  125.                     GotoXY(WhereX-1,WhereY); { Move to the left one position }
  126.                     if DrawMode = True then
  127.                       Begin
  128.                         Write(#196);
  129.                         GotoXY(WhereX-1,WhereY); { Move the cursor onto the }
  130.                       End;                       { character which was drawn}
  131.                   End;
  132.       ColorUp   : If DrawColor < 15 then inc(DrawColor) { Foreground colors }
  133.                   else DrawColor := 0;                  { are from 0 to 15  }
  134.       ColorDn   : If DrawColor > 0 then dec(DrawColor)
  135.                   else DrawColor := 15;
  136.       BkColorUp : if BkColor < 15 then inc(BkColor)     { Background colors }
  137.                   else BkColor := 0;                    { are from 0 to 7   }
  138.       BkColorDn : if BkColor > 0 then dec(BkColor)
  139.                   else BkColor := 15;
  140.       SetDMKey  : If HiKey = TRUE then { make sure we have a Hi Key }
  141.                     if DrawMode = TRUE then DrawMode := FALSE
  142.                     else DrawMode := TRUE;          { Toggle Draw Mode }
  143.       TRtCorner : if HiKey = TRUE then   { Routine to Draw Top Right Corner }
  144.                     begin
  145.                       write(#218);
  146.                       GotoXY(WhereX-1,WhereY);
  147.                      end;
  148.       TLtCorner : if HiKey = TRUE then   { Routine to Draw Top Left Corner  }
  149.                     begin
  150.                       write(#191);
  151.                       GotoXY(WhereX-1,WhereY);
  152.                     end;
  153.       BRtCorner : if HiKey = TRUE then { Routine to Draw Bottom Right Corner }
  154.                     begin
  155.                       write(#192);
  156.                       GotoXY(WhereX-1,WhereY);
  157.                     end;
  158.       BLtCorner : if HiKey = TRUE then { Routine to Draw Bottom Left Corner }
  159.                     begin
  160.                       write(#217);
  161.                       GotoXY(WhereX-1,WhereY);
  162.                     end;
  163.  
  164.       ClrKey    : if HiKey = TRUE then Setup; { Clear the Screen }
  165.       #32..#136 : If HiKey = FALSE then { Routine to write an ASCII }
  166.                     Begin               { character to the screen   }
  167.                       write(Ch);
  168.                       if WhereX=1 then
  169.                         GotoXY(80,WhereY-1);
  170.                     End;
  171.  
  172.      end;
  173.  
  174.   Until (Ch=#27) or ((Ch=#45) and (HiKey=TRUE)); { Until ESC or <ALT>X }
  175.  
  176.   Begin
  177.     ClrScr;
  178.     TextMode(LastMode);
  179.   End;
  180. End;
  181.  
  182. Begin
  183.   Setup;
  184.   Draw;
  185. End.
  186.  
  187. ------------> End of Listing
  188.  
  189.         The actual code is very simple and is explained at as move
  190. through it.  It start (as always) at the bottom 'Begin'.  Immediately
  191. the program moves to the setup procedure which puts it into 80 by 25
  192. Color Text Mode.  Then the screen is setup.  Next the program moves to
  193. the drawing routine.  Each key is read, processed, and the so on until
  194. the key read is either ESC or <ALT>X.  At it drops out of the loop and
  195. exits.  During the loop, the current cursor position, the Drawing Status
  196. and colors and updated and set.
  197.  
  198.         Obviously the program lacks any real on-line help, a save
  199. routine and the popular animation offered by TheDraw~ and other ANSI
  200. drawing programs.  Still, it shows how easily a seemily complex program
  201. can be written in just a few hours using Turbo Pascal.
  202.  
  203. If you have any problems/comments I can be contact at any of the following:
  204.  
  205.         Keep BBS      : 717-675-4068
  206.         Air Force BBS : 717-825-3899
  207.  
  208.         CompuServe at 70314,2321
  209.  
  210. That's all from here - Thanks for reading - Ben Shoval 10/19/91
  211.  
  212. ~ TheDraw is Copyright 1986,1987,1988,1989 by TheSoft Programming
  213.   Services and Ian E. Davis
  214.